home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvg103.zip / TVGDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-29  |  17KB  |  637 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Demo                            }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program TVDemo;
  10.  
  11. {$X+,S-}
  12. {$M 16384,8192,655360}
  13.  
  14. { Turbo Vision demo program. This program uses many of the Turbo
  15.   Vision standard and demo units, including:
  16.  
  17.     StdDlg    - Open file browser, change directory tree.
  18.     MsgBox    - Simple dialog to display messages.
  19.     ColorSel  - Color customization.
  20.     Gadgets   - Shows system time and available heap space.
  21.     AsciiTab  - ASCII table.
  22.     Calendar  - View a month at a time
  23.     Calc      - Desktop calculator.
  24.     FViewer   - Scroll through text files.
  25.     HelpFile  - Context sensitive help.
  26.     MouseDlg  - Mouse options dialog.
  27.     Puzzle    - Simple brain puzzle.
  28.  
  29.   And of course this program includes many standard Turbo Vision
  30.   objects and behaviors (menubar, desktop, status line, dialog boxes,
  31.   mouse support, window resize/move/tile/cascade).
  32. }
  33.  
  34. uses
  35.   Dos, TvGraph, Objects, Drivers, Memory, Views, Menus, Dialogs, StdDlg, MsgBox, App,
  36.   DemoCmds, {Gadgets, }Puzzle, Calendar, AsciiTab, Calc, FViewer, HelpFile,
  37.   DemoHelp, ColorSel, MouseDlg, Styx, Crt;
  38.  
  39. type
  40.  
  41.   { TTVDemo }
  42.  
  43.   PTVDemo = ^TTVDemo;
  44.   TTVDemo = object(TApplication)
  45. {    Clock: PClockView;
  46.     Heap: PHeapView;}
  47.     constructor Init;
  48.     procedure FileOpen(WildCard: PathStr);
  49.     procedure GetEvent(var Event: TEvent); virtual;
  50.     function GetPalette: PPalette; virtual;
  51.     procedure HandleEvent(var Event: TEvent); virtual;
  52.     procedure Idle; virtual;
  53.     procedure InitMenuBar; virtual;
  54.     procedure InitStatusLine; virtual;
  55.     procedure LoadDesktop(var S: TStream);
  56.     procedure OutOfMemory; virtual;
  57.     procedure StoreDesktop(var S: TStream);
  58.     procedure ViewFile(FileName: PathStr);
  59.   end;
  60.  
  61. { CalcHelpName }
  62.  
  63. function CalcHelpName: PathStr;
  64. var
  65.   EXEName: PathStr;
  66.   Dir: DirStr;
  67.   Name: NameStr;
  68.   Ext: ExtStr;
  69. begin
  70.   if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  71.   else EXEName := FSearch('TVDEMO.EXE', GetEnv('PATH'));
  72.   FSplit(EXEName, Dir, Name, Ext);
  73.   if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  74.   CalcHelpName := FSearch('DEMOHELP.HLP', Dir);
  75. end;
  76.  
  77.  
  78. { TTVDemo }
  79. constructor TTVDemo.Init;
  80. var
  81.   R: TRect;
  82.   I: Integer;
  83.   FileName: PathStr;
  84. begin
  85.   TApplication.Init;
  86.   ShadowSize.X:=0;
  87.   ShadowSize.Y:=0;
  88.   RegisterObjects;
  89.   RegisterViews;
  90.   RegisterMenus;
  91.   RegisterDialogs;
  92.   RegisterApp;
  93.   RegisterHelpFile;
  94.   RegisterPuzzle;
  95.   RegisterCalendar;
  96.   RegisterAsciiTab;
  97.   RegisterCalc;
  98.   RegisterFViewer;
  99.   RegisterStyx;
  100.  
  101. {  GetExtent(R);
  102.   R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  103.   Clock := New(PClockView, Init(R));
  104.   Insert(Clock);
  105.  
  106.   GetExtent(R);
  107.   Dec(R.B.X);
  108.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  109.   Heap := New(PHeapView, Init(R));
  110.   Insert(Heap); }
  111.  
  112.   for I := 1 to ParamCount do
  113.   begin
  114.     FileName := ParamStr(I);
  115.     if FileName[Length(FileName)] = '\' then
  116.       FileName := FileName + '*.*';
  117.     if (Pos('?', FileName) = 0) and (Pos('*', FileName) = 0) then
  118.       ViewFile(FExpand(FileName))
  119.     else FileOpen(FileName);
  120.   end;
  121. end;
  122.  
  123. procedure TTVDemo.FileOpen(WildCard: PathStr);
  124. var
  125.   D: PFileDialog;
  126.   FileName: PathStr;
  127. begin
  128.   D := New(PFileDialog, Init(WildCard, 'Open a File',
  129.     '~N~ame', fdOpenButton + fdHelpButton, 100));
  130.   D^.HelpCtx := hcFOFileOpenDBox;
  131.   if ValidView(D) <> nil then
  132.   begin
  133.     if Desktop^.ExecView(D) <> cmCancel then
  134.     begin
  135.       D^.GetFileName(FileName);
  136.       ViewFile(FileName);
  137.     end;
  138.     Dispose(D, Done);
  139.   end;
  140. end;
  141.  
  142. procedure TTVDemo.GetEvent(var Event: TEvent);
  143. var
  144.   W: PWindow;
  145.   HFile: PHelpFile;
  146.   HelpStrm: PDosStream;
  147. const
  148.   HelpInUse: Boolean = False;
  149. begin
  150.   TApplication.GetEvent(Event);
  151.   case Event.What of
  152.     evCommand:
  153.       if (Event.Command = cmHelp) and not HelpInUse then
  154.       begin
  155.         HelpInUse := True;
  156.         HelpStrm := New(PDosStream, Init(CalcHelpName, stOpenRead));
  157.         HFile := New(PHelpFile, Init(HelpStrm));
  158.         if HelpStrm^.Status <> stOk then
  159.         begin
  160.           MessageBox('Could not open help file.', nil, mfError + mfOkButton);
  161.           Dispose(HFile, Done);
  162.         end
  163.         else
  164.         begin
  165.           W := New(PHelpWindow,Init(HFile, GetHelpCtx));
  166.           if ValidView(W) <> nil then
  167.           begin
  168.             ExecView(W);
  169.             Dispose(W, Done);
  170.           end;
  171.           ClearEvent(Event);
  172.         end;
  173.         HelpInUse := False;
  174.       end;
  175.     evMouseDown:
  176.       if Event.Buttons <> 1 then Event.What := evNothing;
  177.   end;
  178. end;
  179.  
  180. function TTVDemo.GetPalette: PPalette;
  181. const
  182.   CNewColor = CColor + CHelpColor;
  183.   CNewBlackWhite = CBlackWhite + CHelpBlackWhite;
  184.   CNewMonochrome = CMonochrome + CHelpMonochrome;
  185.   P: array[apColor..apMonochrome] of string[Length(CNewColor)] =
  186.     (CNewColor, CNewBlackWhite, CNewMonochrome);
  187. begin
  188.   GetPalette := @P[AppPalette];
  189. end;
  190.  
  191. procedure TTVDemo.HandleEvent(var Event: TEvent);
  192.  
  193. procedure ChangeDir;
  194. var
  195.   D: PChDirDialog;
  196. begin
  197.   D := New(PChDirDialog, Init(cdNormal + cdHelpButton, 101));
  198.   D^.HelpCtx := hcFCChDirDBox;
  199.   if ValidView(D) <> nil then
  200.   begin
  201.     DeskTop^.ExecView(D);
  202.     Dispose(D, Done);
  203.   end;
  204. end;
  205.  
  206. procedure Tile;
  207. var
  208.   R: TRect;
  209. begin
  210.   Desktop^.GetExtent(R);
  211.   Desktop^.Tile(R);
  212. end;
  213.  
  214. procedure Cascade;
  215. var
  216.   R: TRect;
  217. begin
  218.   Desktop^.GetExtent(R);
  219.   Desktop^.Cascade(R);
  220. end;
  221.  
  222. procedure Puzzle;
  223. var
  224.   P: PPuzzleWindow;
  225. begin
  226.   P := New(PPuzzleWindow, Init);
  227.   P^.HelpCtx := hcPuzzle;
  228.   Desktop^.Insert(ValidView(P));
  229. end;
  230.  
  231. procedure Calendar;
  232. var
  233.   P: PCalendarWindow;
  234. begin
  235.   P := New(PCalendarWindow, Init);
  236.   P^.HelpCtx := hcCalendar;
  237.   Desktop^.Insert(ValidView(P));
  238. end;
  239.  
  240. procedure About;
  241. var
  242.   D: PDialog;
  243.   Control: PView;
  244.   R: TRect;
  245. begin
  246.   R.Assign(0, 0, 40, 11);
  247.   D := New(PDialog, Init(R, 'About'));
  248.   with D^ do
  249.   begin
  250.     Options := Options or ofCentered;
  251.  
  252.     R.Grow(-1, -1);
  253.     Dec(R.B.Y, 3);
  254.     Insert(New(PStaticText, Init(R,
  255.       #13 +
  256.       ^C'Turbo Vision Demo'#13 +
  257.       #13 +
  258.       ^C'Copyright (c) 1990'#13 +
  259.       #13 +
  260.       ^C'Borland International')));
  261.  
  262.     R.Assign(15, 8, 25, 10);
  263.     Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  264.   end;
  265.   if ValidView(D) <> nil then
  266.   begin
  267.     Desktop^.ExecView(D);
  268.     Dispose(D, Done);
  269.   end;
  270. end;
  271.  
  272. procedure AsciiTab;
  273. var
  274.   P: PAsciiChart;
  275. begin
  276.   P := New(PAsciiChart, Init);
  277.   P^.HelpCtx := hcAsciiTable;
  278.   Desktop^.Insert(ValidView(P));
  279. end;
  280.  
  281. procedure OpenStyx;
  282. var
  283.   P: PStyxDemo;
  284. begin
  285.   P := New(PStyxDemo, Init);
  286.   P^.HelpCtx := hcNoContext;
  287.   Desktop^.Insert(ValidView(P));
  288. end;
  289.  
  290. procedure Calculator;
  291. var
  292.   P: PCalculator;
  293. begin
  294.   P := New(PCalculator, Init);
  295.   P^.HelpCtx := hcCalculator;
  296.   if ValidView(P) <> nil then
  297.     Desktop^.Insert(P);
  298. end;
  299.  
  300. procedure Colors;
  301. var
  302.   D: PColorDialog;
  303. begin
  304.   D := New(PColorDialog, Init('',
  305.     ColorGroup('Desktop',
  306.       ColorItem('Color',             32, nil),
  307.     ColorGroup('Menus',
  308.       ColorItem('Normal',            2,
  309.       ColorItem('Disabled',          3,
  310.       ColorItem('Shortcut',          4,
  311.       ColorItem('Selected',          5,
  312.       ColorItem('Selected disabled', 6,
  313.       ColorItem('Shortcut selected', 7, nil)))))),
  314.     ColorGroup('Dialogs/Calc',
  315.       ColorItem('Frame/background',  33,
  316.       ColorItem('Frame icons',       34,
  317.       ColorItem('Scroll bar page',   35,
  318.       ColorItem('Scroll bar icons',  36,
  319.       ColorItem('Static text',       37,
  320.  
  321.       ColorItem('Label normal',      38,
  322.       ColorItem('Label selected',    39,
  323.       ColorItem('Label shortcut',    40,
  324.  
  325.       ColorItem('Button normal',     41,
  326.       ColorItem('Button default',    42,
  327.       ColorItem('Button selected',   43,
  328.       ColorItem('Button disabled',   44,
  329.       ColorItem('Button shortcut',